home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / program / pkunexap.zip / UnZip.Bas < prev    next >
BASIC Source File  |  1996-08-01  |  6KB  |  161 lines
  1. Attribute VB_Name = "basDosShell"
  2. Option Explicit
  3. 'Close window declarations
  4. 'Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
  5. 'Declare Function CloseWindow Lib "user32" (ByVal hWnd As Long) As Long
  6.  
  7. 'Send and close window api calls
  8. Dim MhWnd As Long       'The hWnd of the window opened and closed
  9. Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  10. 'The two constants below are the message to send
  11. 'the first probalby uses proper methods (ie the ones a user would use) to close the window
  12. 'the second could just destroy the window and may leave the program running or still in memory
  13. Public Const WM_CLOSE = &H10
  14. 'Public Const WM_DESTROY = &H2
  15.  
  16. 'FindWindows declarations
  17. Declare Function GetDesktopWindow Lib "user32.dll" () As Long
  18. Declare Function GetWindow Lib "user32.dll" _
  19.     (ByVal hWnd As Long, ByVal uCmd As Long) As Long
  20. Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" _
  21.     (ByVal hWnd As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
  22. Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" _
  23.     (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
  24. Declare Function GetParent Lib "user32.dll" (ByVal hWnd As Long) As Long
  25. Declare Function GetWindowWord Lib "user32.dll" (ByVal hWnd As Long, _
  26.     ByVal nIndex As Long) As Integer
  27.  
  28. Global Const GW_HWNDNEXT = 2
  29. Global Const GW_CHILD = 5
  30. Global Const GWW_ID = (-12)
  31.  
  32. Function FindWindowLike(hWndArray() As Long, ByVal hWndStart As _
  33.    Long, WindowText As String, Classname As String, ID) As Integer
  34. 'FindWindowLike
  35. ' - Finds the window handles of the windows matching the specified
  36. '   parameters
  37. 'hwndArray()
  38. ' - An integer array used to return the window handles
  39. 'hWndStart
  40. ' - The handle of the window to search under.
  41. ' - The routine searches through all of this window's children and their
  42. '   children recursively.
  43. ' - If hWndStart = 0 then the routine searches through all windows.
  44. 'WindowText
  45. ' - The pattern used with the Like operator to compare window's text.
  46. 'ClassName
  47. ' - The pattern used with the Like operator to compare window's class
  48. '   name.
  49. 'ID
  50. ' - A child ID number used to identify a window.
  51. ' - Can be a decimal number or a hex string.
  52. ' - Prefix hex strings with "&H" or an error will occur.
  53. ' - To ignore the ID pass the Visual Basic Null function.
  54. 'Returns
  55. ' - The number of windows that matched the parameters.
  56. ' - Also returns the window handles in hWndArray()
  57. '----------------------------------------------------------------------
  58.  
  59. Dim LhWnd As Long
  60. Dim sWindowText As String
  61. Dim sClassname As String
  62. Dim sID
  63. Dim r As Long
  64. ' Hold the level of recursion:
  65. Static level As Integer
  66. ' Hold the number of matching windows:
  67. Static iFound As Integer
  68.  
  69. ' Initialize if necessary:
  70. If level = 0 Then
  71.    iFound = 0
  72.    ReDim hWndArray(0 To 0)
  73.    If hWndStart = 0 Then hWndStart = GetDesktopWindow()
  74. End If
  75.  
  76. ' Increase recursion counter:
  77. level = level + 1
  78.  
  79. ' Get first child window:
  80. LhWnd = GetWindow(hWndStart, GW_CHILD)
  81.  
  82. Do Until LhWnd = 0
  83.    ' Search children by recursion:
  84.    r = FindWindowLike(hWndArray(), LhWnd, WindowText, Classname, ID)
  85.  
  86.    ' Get the window text and class name:
  87.    sWindowText = Space(255)
  88.    r = GetWindowText(LhWnd, sWindowText, 255)
  89.    sWindowText = Left(sWindowText, r)
  90.    sClassname = Space(255)
  91.    r = GetClassName(LhWnd, sClassname, 255)
  92.    sClassname = Left(sClassname, r)
  93.  
  94.    ' If window is a child get the ID:
  95.    If GetParent(LhWnd) <> 0 Then
  96.       r = GetWindowWord(LhWnd, GWW_ID)
  97.       sID = CLng("&H" & Hex(r))
  98.    Else
  99.       sID = Null
  100.    End If
  101.  
  102.    ' Check that window matches the search parameters:
  103.    If sWindowText Like WindowText Then
  104.    'And sClassname Like Classname Then
  105.       If IsNull(ID) Then
  106.          ' If find a match, increment counter and add handle to array:
  107.          iFound = iFound + 1
  108.          ReDim Preserve hWndArray(0 To iFound)
  109.          hWndArray(iFound) = LhWnd
  110.       ElseIf Not IsNull(sID) Then
  111.          If sID = CLng(ID) Then
  112.             ' If find a match increment counter and add handle to array:
  113.             iFound = iFound + 1
  114.             ReDim Preserve hWndArray(0 To iFound)
  115.             hWndArray(iFound) = LhWnd
  116.          End If
  117.       End If
  118.    End If
  119.    ' Get next child window:
  120.    LhWnd = GetWindow(LhWnd, GW_HWNDNEXT)
  121. Loop
  122. ' Decrement recursion counter:
  123. level = level - 1
  124. ' Return the number of windows found:
  125. FindWindowLike = iFound
  126. End Function
  127.  
  128. Public Function ShellAndClose(CommandLine As String) As Boolean
  129. On Error GoTo Err
  130. Dim X As Long, J As Integer, Ret As Integer
  131. 'Array of hWnds
  132. Static hWnds() As Long
  133. 'Set the function to false
  134. ShellAndClose = False
  135. 'Shell the commandline
  136. X = Shell(CommandLine, 2) ' Open an MS-DOS Window
  137.  
  138. 'This next loop finds the window hWnd of any window
  139. 'If you use this function to shell dos programs make sure the 3rd param
  140. 'is "Finished" this way you know the Dos prog has finished
  141.  
  142. Do Until Ret = 1        'Ret is the number of windows found
  143.     Ret = FindWindowLike(hWnds(), 0, "Finished*", "*", Null)
  144. Loop
  145.  
  146. 'If one is found set the hWnd to MhWnd so it can be closed
  147. MhWnd = hWnds(1)
  148. If MhWnd <> frmMain.hWnd Then 'Make sure you dont close yourself
  149.     'Close the Window of hWnd MhWnd
  150.     X = PostMessage(MhWnd, WM_CLOSE, 0, 0)
  151.     'Set the function to true
  152.     ShellAndClose = True
  153. End If
  154. Exit Function
  155. Err:
  156. 'Something failed
  157. ShellAndClose = False
  158. Debug.Print "The Error No is : " & Err.Number
  159. End Function
  160.  
  161.